home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tests / set.test < prev    next >
Text File  |  1993-06-26  |  19KB  |  579 lines

  1. # Commands covered:  set, unset, array
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/set.test,v 1.11 93/06/26 17:38:53 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. proc ignore args {}
  32.  
  33. # Simple variable operations.
  34.  
  35. catch {unset a}
  36. test set-1.1 {basic variable setting and unsetting} {
  37.     set a 22
  38. } 22
  39. test set-1.2 {basic variable setting and unsetting} {
  40.     set a 123
  41.     set a
  42. } 123
  43. test set-1.3 {basic variable setting and unsetting} {
  44.     set a xxx
  45.     format %s $a
  46. } xxx
  47. test set-1.4 {basic variable setting and unsetting} {
  48.     set a 44
  49.     unset a
  50.     list [catch {set a} msg] $msg
  51. } {1 {can't read "a": no such variable}}
  52.  
  53. # Basic array operations.
  54.  
  55. catch {unset a}
  56. set a(xyz) 2
  57. set a(44) 3
  58. set {a(a long name)} test
  59. test set-2.1 {basic array operations} {
  60.     lsort [array names a]
  61. } {44 {a long name} xyz}
  62. test set-2.2 {basic array operations} {
  63.     set a(44)
  64. } 3
  65. test set-2.3 {basic array operations} {
  66.     set a(xyz)
  67. } 2
  68. test set-2.4 {basic array operations} {
  69.     set "a(a long name)"
  70. } test
  71. test set-2.5 {basic array operations} {
  72.     list [catch {set a(other)} msg] $msg
  73. } {1 {can't read "a(other)": no such element in array}}
  74. test set-2.6 {basic array operations} {
  75.     list [catch {set a} msg] $msg
  76. } {1 {can't read "a": no such variable}}
  77. test set-2.7 {basic array operations} {
  78.     format %s $a(44)
  79. } 3
  80. test set-2.8 {basic array operations} {
  81.     format %s $a(a long name)
  82. } test
  83. unset a(44)
  84. test set-2.9 {basic array operations} {
  85.     lsort [array names a]
  86. } {{a long name} xyz}
  87. test set-2.10 {basic array operations} {
  88.     catch {unset b}
  89.     list [catch {set b(123)} msg] $msg
  90. } {1 {can't read "b(123)": no such variable}}
  91. test set-2.11 {basic array operations} {
  92.     catch {unset b}
  93.     set b 44
  94.     list [catch {set b(123)} msg] $msg
  95. } {1 {can't read "b(123)": variable isn't array}}
  96. test set-2.12 {basic array operations} {
  97.     list [catch {set a} msg] $msg
  98. } {1 {can't read "a": no such variable}}
  99. test set-2.13 {basic array operations} {
  100.     list [catch {set a 14} msg] $msg
  101. } {1 {can't set "a": variable is array}}
  102. unset a
  103. test set-2.14 {basic array operations} {
  104.     list [catch {set a(xyz)} msg] $msg
  105. } {1 {can't read "a(xyz)": no such variable}}
  106.  
  107. # Test the set commands, and exercise the corner cases of the code
  108. # that parses array references into two parts.
  109.  
  110. test set-3.1 {set command} {
  111.     list [catch {set} msg] $msg
  112. } {1 {wrong # args: should be "set varName ?newValue?"}}
  113. test set-3.2 {set command} {
  114.     list [catch {set x y z} msg] $msg
  115. } {1 {wrong # args: should be "set varName ?newValue?"}}
  116. test set-3.3 {set command} {
  117.     catch {unset a}
  118.     list [catch {set a} msg] $msg
  119. } {1 {can't read "a": no such variable}}
  120. test set-3.4 {set command} {
  121.     catch {unset a}
  122.     set a(14) 83
  123.     list [catch {set a 22} msg] $msg
  124. } {1 {can't set "a": variable is array}}
  125.  
  126. # Test the corner-cases of parsing array names, using set and unset.
  127.  
  128. test set-4.1 {parsing array names} {
  129.     catch {unset a}
  130.     set a(()) 44
  131.     list [catch {array names a} msg] $msg
  132. } {0 ()}
  133. test set-4.2 {parsing array names} {
  134.     catch {unset a a(abcd}
  135.     set a(abcd 33
  136.     info exists a(abcd
  137. } 1
  138. test set-4.3 {parsing array names} {
  139.     catch {unset a a(abcd}
  140.     set a(abcd 33
  141.     list [catch {array names a} msg] $msg
  142. } {1 {"a" isn't an array}}
  143. test set-4.4 {parsing array names} {
  144.     catch {unset a abcd)}
  145.     set abcd) 33
  146.     info exists abcd)
  147. } 1
  148. test set-4.5 {parsing array names} {
  149.     set a(bcd yyy
  150.     catch {unset a}
  151.     list [catch {set a(bcd} msg] $msg
  152. } {0 yyy}
  153. test set-4.6 {parsing array names} {
  154.     catch {unset a}
  155.     set a 44
  156.     list [catch {set a(bcd test} msg] $msg
  157. } {0 test}
  158.  
  159. # Errors in reading variables
  160.  
  161. test set-5.1 {errors in reading variables} {
  162.     catch {unset a}
  163.     list [catch {set a} msg] $msg
  164. } {1 {can't read "a": no such variable}}
  165. test set-5.2 {errors in reading variables} {
  166.     catch {unset a}
  167.     set a 44
  168.     list [catch {set a(18)} msg] $msg
  169. } {1 {can't read "a(18)": variable isn't array}}
  170. test set-5.3 {errors in reading variables} {
  171.     catch {unset a}
  172.     set a(6) 44
  173.     list [catch {set a(18)} msg] $msg
  174. } {1 {can't read "a(18)": no such element in array}}
  175. test set-5.4 {errors in reading variables} {
  176.     catch {unset a}
  177.     set a(6) 44
  178.     list [catch {set a} msg] $msg
  179. } {1 {can't read "a": no such variable}}
  180.  
  181. # Errors and other special cases in writing variables
  182.  
  183. test set-6.1 {creating array during write} {
  184.     catch {unset a}
  185.     trace var a rwu ignore
  186.     list [catch {set a(14) 186} msg] $msg [array names a]
  187. } {0 186 14}
  188. test set-6.2 {errors in writing variables} {
  189.     catch {unset a}
  190.     set a xxx
  191.     list [catch {set a(14) 186} msg] $msg
  192. } {1 {can't set "a(14)": variable isn't array}}
  193. test set-6.3 {errors in writing variables} {
  194.     catch {unset a}
  195.     set a(100) yyy
  196.     list [catch {set a 2} msg] $msg
  197. } {1 {can't set "a": variable is array}}
  198. test set-6.4 {expanding variable size} {
  199.     catch {unset a}
  200.     list [set a short] [set a "longer name"] [set a "even longer name"] \
  201.         [set a "a much much truly longer name"]
  202. } {short {longer name} {even longer name} {a much much truly longer name}}
  203.  
  204. # Unset command, Tcl_UnsetVar procedures
  205.  
  206. test set-7.1 {unset command} {
  207.     catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d}
  208.     set a 44
  209.     set b 55
  210.     set c 66
  211.     set d 77
  212.     unset a b c
  213.     list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
  214.         [catch {set d(0) 0}]
  215. } {0 0 0 1}
  216. test set-7.2 {unset command} {
  217.     list [catch {unset} msg] $msg
  218. } {1 {wrong # args: should be "unset varName ?varName ...?"}}
  219. test set-7.3 {unset command} {
  220.     catch {unset a}
  221.     list [catch {unset a} msg] $msg
  222. } {1 {can't unset "a": no such variable}}
  223. test set-7.4 {unset command} {
  224.     catch {unset a}
  225.     set a 44
  226.     list [catch {unset a(14)} msg] $msg
  227. } {1 {can't unset "a(14)": variable isn't array}}
  228. test set-7.5 {unset command} {
  229.     catch {unset a}
  230.     set a(0) xx
  231.     list [catch {unset a(14)} msg] $msg
  232. } {1 {can't unset "a(14)": no such element in array}}
  233. test set-7.6 {unset command} {
  234.     catch {unset a}; catch {unset b}; catch {unset c}
  235.     set a foo
  236.     set c gorp
  237.     list [catch {unset a a a(14)} msg] $msg [info exists c]
  238. } {1 {can't unset "a": no such variable} 1}
  239. test set-7.7 {unsetting globals from within procedures} {
  240.     set y 0
  241.     proc p1 {} {
  242.     global y
  243.     set z [p2]
  244.     return [list $z [catch {set y} msg] $msg]
  245.     }
  246.     proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
  247.     p1
  248. } {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}}
  249. test set-7.8 {unsetting globals from within procedures} {
  250.     set y 0
  251.     proc p1 {} {
  252.     global y
  253.     p2
  254.     return [list [catch {set y 44} msg] $msg]
  255.     }
  256.     proc p2 {} {global y; unset y}
  257.     concat [p1] [list [catch {set y} msg] $msg]
  258. } {0 44 0 44}
  259. test set-7.9 {unsetting globals from within procedures} {
  260.     set y 0
  261.     proc p1 {} {
  262.     global y
  263.     unset y
  264.     return [list [catch {set y 55} msg] $msg]
  265.     }
  266.     concat [p1] [list [catch {set y} msg] $msg]
  267. } {0 55 0 55}
  268. test set-7.10 {unset command} {
  269.     catch {unset a}
  270.     set a(14) 22
  271.     unset a(14)
  272.     list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
  273. } {1 {can't read "a(14)": no such element in array} 0 {}}
  274. test set-7.11 {unset command} {
  275.     catch {unset a}
  276.     set a(14) 22
  277.     unset a
  278.     list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
  279. } {1 {can't read "a(14)": no such variable} 1 {"a" isn't an array}}
  280.  
  281. # Array command.
  282.  
  283. test set-8.1 {array command} {
  284.     list [catch {array} msg] $msg
  285. } {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
  286. test set-8.2 {array command} {
  287.     catch {unset a}
  288.     list [catch {array names a} msg] $msg
  289. } {1 {"a" isn't an array}}
  290. test set-8.3 {array command} {
  291.     catch {unset a}
  292.     set a 44
  293.     list [catch {array names a} msg] $msg
  294. } {1 {"a" isn't an array}}
  295. test set-8.4 {array command} {
  296.     catch {unset a}
  297.     set a(22) 3
  298.     list [catch {array gorp a} msg] $msg
  299. } {1 {bad option "gorp": should be anymore, donesearch, names, nextelement, size, or startsearch}}
  300. test set-8.5 {array command, names option} {
  301.     catch {unset a}
  302.     set a(22) 3
  303.     list [catch {array names a 4} msg] $msg
  304. } {1 {wrong # args: should be "array names arrayName"}}
  305. test set-8.6 {array command, names option} {
  306.     catch {unset a}
  307.     set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
  308.     list [catch {lsort [array names a]} msg] $msg
  309. } {0 {22 Textual_name {name with spaces}}}
  310. test set-8.7 {array command, names option} {
  311.     catch {unset a}
  312.     set a(22) 3; set a(33) 44;
  313.     trace var a(xxx) w ignore
  314.     list [catch {lsort [array names a]} msg] $msg
  315. } {0 {22 33}}
  316. test set-8.8 {array command, names option} {
  317.     catch {unset a}
  318.     set a(22) 3; set a(33) 44;
  319.     trace var a(xxx) w ignore
  320.     set a(xxx) value
  321.     list [catch {lsort [array names a]} msg] $msg
  322. } {0 {22 33 xxx}}
  323. test set-8.9 {array command, size option} {
  324.     catch {unset a}
  325.     set a(22) 3
  326.     list [catch {array size a 4} msg] $msg
  327. } {1 {wrong # args: should be "array size arrayName"}}
  328. test set-8.10 {array command, size option} {
  329.     catch {unset a}
  330.     set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
  331.     list [catch {array size a} msg] $msg
  332. } {0 3}
  333. test set-8.10 {array command, size option} {
  334.     catch {unset a}
  335.     set a(22) 3; set a(xx) 44; set a(y) xxx
  336.     unset a(22) a(y) a(xx)
  337.     list [catch {array size a} msg] $msg
  338. } {0 0}
  339. test set-8.11 {array command, size option} {
  340.     catch {unset a}
  341.     set a(22) 3;
  342.     trace var a(33) rwu ignore
  343.     list [catch {array size a} msg] $msg
  344. } {0 1}
  345.  
  346. test set-9.1 {ids for array enumeration} {
  347.     catch {unset a}
  348.     set a(a) 1
  349.     list [array st a] [array st a] [array done a s-1-a; array st a] \
  350.         [array done a s-2-a; array d a s-3-a; array start a]
  351. } {s-1-a s-2-a s-3-a s-1-a}
  352. test set-9.2 {array enumeration} {
  353.     catch {unset a}
  354.     set a(a) 1
  355.     set a(b) 1
  356.     set a(c) 1
  357.     set x [array startsearch a]
  358.     list [array nextelement a $x] [array ne a $x] [array next a $x] \
  359.         [array next a $x] [array next a $x]
  360. } {a b c {} {}}
  361. test set-9.3 {array enumeration} {
  362.     catch {unset a}
  363.     set a(a) 1
  364.     set a(b) 1
  365.     set a(c) 1
  366.     set x [array startsearch a]
  367.     set y [array startsearch a]
  368.     set z [array startsearch a]
  369.     list [array nextelement a $x] [array ne a $x] \
  370.         [array next a $y] [array next a $z] [array next a $y] \
  371.         [array next a $z] [array next a $y] [array next a $z] \
  372.         [array next a $y] [array next a $z] [array next a $x] \
  373.         [array next a $x]
  374. } {a b a a b b c c {} {} c {}}
  375. test set-9.4 {array enumeration: stopping searches} {
  376.     catch {unset a}
  377.     set a(a) 1
  378.     set a(b) 1
  379.     set a(c) 1
  380.     set x [array startsearch a]
  381.     set y [array startsearch a]
  382.     set z [array startsearch a]
  383.     list [array next a $x] [array next a $x] [array next a $y] \
  384.         [array done a $z; array next a $x] \
  385.         [array done a $x; array next a $y] [array next a $y]
  386. } {a b a c b c}
  387. test set-9.5 {array enumeration: stopping searches} {
  388.     catch {unset a}
  389.     set a(a) 1
  390.     set x [array startsearch a]
  391.     array done a $x
  392.     list [catch {array next a $x} msg] $msg
  393. } {1 {couldn't find search "s-1-a"}}
  394. test set-9.6 {array enumeration: searches automatically stopped} {
  395.     catch {unset a}
  396.     set a(a) 1
  397.     set x [array startsearch a]
  398.     set y [array startsearch a]
  399.     set a(b) 1
  400.     list [catch {array next a $x} msg] $msg \
  401.         [catch {array next a $y} msg2] $msg2
  402. } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
  403. test set-9.7 {array enumeration: searches automatically stopped} {
  404.     catch {unset a}
  405.     set a(a) 1
  406.     set x [array startsearch a]
  407.     set y [array startsearch a]
  408.     set a(a) 2
  409.     list [catch {array next a $x} msg] $msg \
  410.         [catch {array next a $y} msg2] $msg2
  411. } {0 a 0 a}
  412. test set-9.8 {array enumeration: searches automatically stopped} {
  413.     catch {unset a}
  414.     set a(a) 1
  415.     set a(c) 2
  416.     set x [array startsearch a]
  417.     set y [array startsearch a]
  418.     catch {unset a(c)}
  419.     list [catch {array next a $x} msg] $msg \
  420.         [catch {array next a $y} msg2] $msg2
  421. } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
  422. test set-9.9 {array enumeration: searches automatically stopped} {
  423.     catch {unset a}
  424.     set a(a) 1
  425.     set x [array startsearch a]
  426.     set y [array startsearch a]
  427.     catch {unset a(c)}
  428.     list [catch {array next a $x} msg] $msg \
  429.         [catch {array next a $y} msg2] $msg2
  430. } {0 a 0 a}
  431. test set-9.10 {array enumeration: searches automatically stopped} {
  432.     catch {unset a}
  433.     set a(a) 1
  434.     set x [array startsearch a]
  435.     set y [array startsearch a]
  436.     trace var a(b) r {}
  437.     list [catch {array next a $x} msg] $msg \
  438.         [catch {array next a $y} msg2] $msg2
  439. } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
  440. test set-9.11 {array enumeration: searches automatically stopped} {
  441.     catch {unset a}
  442.     set a(a) 1
  443.     set x [array startsearch a]
  444.     set y [array startsearch a]
  445.     trace var a(a) r {}
  446.     list [catch {array next a $x} msg] $msg \
  447.         [catch {array next a $y} msg2] $msg2
  448. } {0 a 0 a}
  449. test set-9.12 {array enumeration with traced undefined elements} {
  450.     catch {unset a}
  451.     set a(a) 1
  452.     trace var a(b) r {}
  453.     set x [array startsearch a]
  454.     list [array next a $x] [array next a $x]
  455. } {a {}}
  456.  
  457. test set-10.1 {array enumeration errors} {
  458.     list [catch {array start} msg] $msg
  459. } {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
  460. test set-10.2 {array enumeration errors} {
  461.     list [catch {array start a b} msg] $msg
  462. } {1 {wrong # args: should be "array startsearch arrayName"}}
  463. test set-10.3 {array enumeration errors} {
  464.     catch {unset a}
  465.     list [catch {array start a} msg] $msg
  466. } {1 {"a" isn't an array}}
  467. test set-10.4 {array enumeration errors} {
  468.     catch {unset a}
  469.     set a(a) 1
  470.     set x [array startsearch a]
  471.     list [catch {array next a} msg] $msg
  472. } {1 {wrong # args: should be "array nextelement arrayName searchId"}}
  473. test set-10.5 {array enumeration errors} {
  474.     catch {unset a}
  475.     set a(a) 1
  476.     set x [array startsearch a]
  477.     list [catch {array next a b c} msg] $msg
  478. } {1 {wrong # args: should be "array nextelement arrayName searchId"}}
  479. test set-10.6 {array enumeration errors} {
  480.     catch {unset a}
  481.     set a(a) 1
  482.     set x [array startsearch a]
  483.     list [catch {array next a a-1-a} msg] $msg
  484. } {1 {illegal search identifier "a-1-a"}}
  485. test set-10.7 {array enumeration errors} {
  486.     catch {unset a}
  487.     set a(a) 1
  488.     set x [array startsearch a]
  489.     list [catch {array next a sx1-a} msg] $msg
  490. } {1 {illegal search identifier "sx1-a"}}
  491. test set-10.8 {array enumeration errors} {
  492.     catch {unset a}
  493.     set a(a) 1
  494.     set x [array startsearch a]
  495.     list [catch {array next a s--a} msg] $msg
  496. } {1 {illegal search identifier "s--a"}}
  497. test set-10.9 {array enumeration errors} {
  498.     catch {unset a}
  499.     set a(a) 1
  500.     set x [array startsearch a]
  501.     list [catch {array next a s-1-b} msg] $msg
  502. } {1 {search identifier "s-1-b" isn't for variable "a"}}
  503. test set-10.10 {array enumeration errors} {
  504.     catch {unset a}
  505.     set a(a) 1
  506.     set x [array startsearch a]
  507.     list [catch {array next a s-1ba} msg] $msg
  508. } {1 {illegal search identifier "s-1ba"}}
  509. test set-10.11 {array enumeration errors} {
  510.     catch {unset a}
  511.     set a(a) 1
  512.     set x [array startsearch a]
  513.     list [catch {array next a s-2-a} msg] $msg
  514. } {1 {couldn't find search "s-2-a"}}
  515. test set-10.12 {array enumeration errors} {
  516.     list [catch {array done a} msg] $msg
  517. } {1 {wrong # args: should be "array donesearch arrayName searchId"}}
  518. test set-10.13 {array enumeration errors} {
  519.     list [catch {array done a b c} msg] $msg
  520. } {1 {wrong # args: should be "array donesearch arrayName searchId"}}
  521. test set-10.14 {array enumeration errors} {
  522.     list [catch {array done a b} msg] $msg
  523. } {1 {illegal search identifier "b"}}
  524. test set-10.15 {array enumeration errors} {
  525.     list [catch {array anymore a} msg] $msg
  526. } {1 {wrong # args: should be "array anymore arrayName searchId"}}
  527. test set-10.16 {array enumeration errors} {
  528.     list [catch {array any a b c} msg] $msg
  529. } {1 {wrong # args: should be "array anymore arrayName searchId"}}
  530. test set-10.17 {array enumeration errors} {
  531.     catch {unset a}
  532.     set a(0) 44
  533.     list [catch {array any a bogus} msg] $msg
  534. } {1 {illegal search identifier "bogus"}}
  535.  
  536. # Array enumeration with "anymore" option
  537.  
  538. test set-11.1 {array anymore option} {
  539.     catch {unset a}
  540.     set a(a) 1
  541.     set a(b) 2
  542.     set a(c) 3
  543.     array startsearch a
  544.     list [array anymore a s-1-a] [array next a s-1-a] \
  545.         [array anymore a s-1-a] [array next a s-1-a] \
  546.         [array anymore a s-1-a] [array next a s-1-a] \
  547.         [array anymore a s-1-a] [array next a s-1-a] 
  548. } {1 a 1 b 1 c 0 {}}
  549. test set-11.2 {array anymore option} {
  550.     catch {unset a}
  551.     set a(a) 1
  552.     set a(b) 2
  553.     set a(c) 3
  554.     array startsearch a
  555.     list [array next a s-1-a] [array next a s-1-a] \
  556.         [array anymore a s-1-a] [array next a s-1-a] \
  557.         [array next a s-1-a] [array anymore a s-1-a] 
  558. } {a b 1 c {} 0}
  559.  
  560. # Special check to see that the value of a variable is handled correctly
  561. # if it is returned as the result of a procedure (must not free the variable
  562. # string while deleting the call frame).  Errors will only be detected if
  563. # a memory consistency checker such as Purify is being used.
  564.  
  565. test set-12.1 {cleanup on procedure return} {
  566.     proc foo {} {
  567.     set x 12345
  568.     }
  569.     foo
  570. } 12345
  571.  
  572. # Must delete variables when done, since these arrays get used as
  573. # scalars by other tests.
  574.  
  575. catch {unset a}
  576. catch {unset b}
  577. catch {unset c}
  578. return ""
  579.